home *** CD-ROM | disk | FTP | other *** search
/ PC Media 20 / PC MEDIA CD20.iso / share / prog / firedemo / rundemo.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-10  |  3KB  |  165 lines
  1. {$M 16384,0,0}
  2.  
  3. USES Crt, Dos;
  4.  
  5.  
  6.  
  7.  
  8. FUNCTION GetYN : BOOLEAN;
  9.   VAR
  10.     ch, c : CHAR;
  11.   BEGIN
  12.     ch := #0;
  13.     REPEAT
  14.       ch := ReadKey; IF ch = #0 THEN c := ReadKey;
  15.       IF ch = #27 THEN HALT(1);
  16.       ch := UpCase(ch);
  17.     UNTIL (ch = 'N') OR (ch = 'Y') OR (ch = 'S');
  18.  
  19.     GetYN := ch <> 'N';
  20.   END;
  21.  
  22.  
  23. FUNCTION GetAnswer(n: WORD) : WORD;
  24.   VAR
  25.     ch, c : CHAR;
  26.   BEGIN
  27.     ch := #0;
  28.     REPEAT
  29.       ch := ReadKey; IF ch = #0 THEN c := ReadKey;
  30.       IF ch = #27 THEN HALT(1);
  31.     UNTIL (ch >= '1') AND (ch <= CHAR(n+BYTE('0')));
  32.  
  33.     GetAnswer := BYTE(ch) - BYTE('0');
  34.   END;
  35.  
  36.  
  37.  
  38.  
  39. CONST
  40.   SterTabl : ARRAY[1..8] OF BOOLEAN =
  41.     ( FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, TRUE );
  42.   DevTabl  : ARRAY[1..8] OF STRING[40] =
  43.     (
  44.       'Speaker',
  45.       'AdLib',
  46.       'DAC-SB',
  47.       'DAC-Mono',
  48.       'DAC-Stereo',
  49.       'SBlaster-Mono',
  50.       'DMA-SB-Mono',
  51.       'DMA-SB-Stereo'
  52.     );
  53.   Frectabl : ARRAY[1..8] OF STRING[5] =
  54.     (
  55.       '8000',
  56.       '10000',
  57.       '12000',
  58.       '14000',
  59.       '16000',
  60.       '18000',
  61.       '20000',
  62.       '22000'
  63.     );
  64.  
  65. VAR
  66.   i : WORD;
  67.   p : STRING;
  68.   parm : TEXT;
  69.  
  70. LABEL
  71.   doit;
  72.  
  73. BEGIN
  74.  
  75.   WriteLn;
  76.   WriteLn('           Sound initialisation procedure.');
  77.  
  78.   p := '';
  79.  
  80.   Assign(parm, 'FIRE.CFG');
  81.   Reset(parm);
  82.   ReadLn(parm, p);
  83.   Close(parm);
  84.   IF IOresult = 0 THEN ;
  85.  
  86.   IF p <> '' THEN BEGIN
  87.      WriteLn;
  88.      WriteLn(' Do you want to use the last setup?');
  89.      IF GetYN THEN GOTO doit
  90.   END;
  91.  
  92.   WriteLn;
  93.   WriteLn('Please, select a sound device:');
  94.   WriteLn;
  95.   WriteLn(' [1] PC Internal Speaker');
  96.   WriteLn(' [2] AdLib sound card');
  97.   WriteLn(' [3] DAC + SB (stereo)');
  98.   WriteLn(' [4] DAC mono on LPT1');
  99.   WriteLn(' [5] DAC stereo on LPT1 - LPT2');
  100.   WriteLn(' [6] NON-DMA Sound Blaster');
  101.   WriteLn(' [7] DMA Mono Sound Blaster');
  102.   WriteLn(' [8] DMA Stereo SB Pro or SB 16');
  103.  
  104.   i := GetAnswer(8);
  105.  
  106.   IF SterTabl[i] THEN
  107.     BEGIN
  108.       WriteLn;
  109.       WriteLn('Do you want any stereo mixing?');
  110.       IF GetYN THEN
  111.         BEGIN
  112.           WriteLn;
  113.           WriteLn('Do you want the softer stereo mix?');
  114.           IF GetYN THEN
  115.             p := '/d:Mix-'+DevTabl[i]
  116.           ELSE
  117.             p := '/d:Mix2-'+DevTabl[i];
  118.         END
  119.       ELSE
  120.         p := '/d:'+DevTabl[i];
  121.     END
  122.   ELSE
  123.     BEGIN
  124.       p := '/d:'+DevTabl[i];
  125.  
  126.       WriteLn;
  127.       WriteLn('Do you want to have a loudness filter?');
  128.       WriteLn('(It slows down the demo, but sounds better on a good amplifier)');
  129.       IF GetYN THEN p := p + ' /bfil';
  130.     END;                             
  131.  
  132.   WriteLn;
  133.   WriteLn('Select a sampling frequency:');
  134.   WriteLn;
  135.   WriteLn(' [1]  8000 Hz');
  136.   WriteLn(' [2] 10000 Hz');
  137.   WriteLn(' [3] 12000 Hz');
  138.   WriteLn(' [4] 14000 Hz');
  139.   WriteLn(' [5] 16000 Hz');
  140.   WriteLn(' [6] 18000 Hz');
  141.   WriteLn(' [7] 20000 Hz');
  142.   WriteLn(' [8] 22000 Hz');
  143.  
  144.   i := GetAnswer(8);
  145.  
  146.   p := p + ' /f:'+FrecTabl[i];
  147.  
  148.   WriteLn;
  149.   WriteLn('Do you want to boost up the volume?');
  150.  
  151.   IF NOT GetYN THEN p := p + ' /v:63';
  152.  
  153.   p := p + ' /hq * /sh:Fire.Exe';
  154.  
  155.   Assign(parm, 'FIRE.CFG');
  156.   ReWrite(parm);
  157.   WriteLn(parm, p);
  158.   Close(parm);
  159.   IF IOresult = 0 THEN ;
  160.  
  161. doit:
  162.   Exec('ShellVT.Exe', p);
  163.  
  164. END.
  165.